The Best of MacTutor - S…e Code for Volumes 1 to 5/The Best of MacTutor - Source Code for Volume 1-5 (Wayzata Technology)(6031)(1990).bin/Source Code/#23 (Aug 87)/library manager source/Library Manager

Text File | 1987-07-13 | 14KB | 561 lines

UNIT LibMgr;

INTERFACE
    USES
        Rom85, HFS;

    TYPE
        StandardType = (StandardGet, StandardPut);
        Outcome = (Success, Error, Cancellation);
        str63 = STRING[63];
        str31 = STRING[31];
        str80 = STRING[80];

        LmirPtr = ^Lmir;
        LmirHdl = ^LmirPtr;

        LMIR = RECORD              {Library Manager Information Record}
                rsrcID : integer;
                volname : str31;
                vRef : integer;
                hfsvolume : boolean;
                DirID : Longint;
                filename : str63;
                fRefNum : integer;
                next, prev : LmirHdl;
                FTyp : integer;
                RecsOnFile, CurRec : integer;
                changed : boolean;
                Status : (Open, Closed, NotFound);
            END;

    PROCEDURE GetPathInfo (vRefNum : integer;
                                    VAR rootVol : Str31;
                                    VAR hfsFlag : boolean;
                                    VAR WDirID : longint);


    FUNCTION OpenWD (VAR vRefNum : integer;
                                    DirID : longint) : OSErr;

    PROCEDURE OpenLib (VAR whichLib : LmirHdl;
                                    itsName : str255);

    PROCEDURE OpenLinkedLib (LinkTo : LmirHdl;
                                    ResName : str255);

    FUNCTION CreateLib (VAR newLib : LmirHdl) : boolean;

    FUNCTION FindLib (VAR theLib : LmirHdl) : boolean;

    PROCEDURE RemoveLib (VAR whichFile : LmirHdl);       {Close file and remove from list of open libraries}

    PROCEDURE CloseLibList (Top : LmirHdl);                 {Close all open libraries in a given list and empty list}

    FUNCTION StandardFile (opCode : StandardType;
                                    oldName : Str255;
                                    fType : OSType;
                                    VAR vRef : integer) : str63;

    PROCEDURE GetLibraryResource (VAR theLibrary : LmirHdl;
                                    ResourceName : str255);

IMPLEMENTATION

    FUNCTION HFSRunning : boolean;
        CONST
            FSFCBLen = $3F6;
        VAR
            HFS : ^INTEGER;
    BEGIN
        HFS := POINTER(FSFCBLen);
        HFSRunning := (HFS^ > 0);
    END;

    FUNCTION NewRoms : boolean;
        CONST
            NewRomsID = 117;
        VAR
            RomVersion, Machine : INTEGER;
    BEGIN
        Environs(RomVersion, Machine);
        NewRoms := RomVersion >= NewRomsID;
    END;

    FUNCTION GetErrorMsg (Result : OSErr) : str80;
    BEGIN
        Result := abs(Result);

        CASE Result OF
            33 :
                GetErrorMsg := 'the file directory is full.  ';
            34 :
                GetErrorMsg := 'all allocation blocks on the volume are full.  ';
            35 :
                GetErrorMsg := 'the specified volume is not mounted.  ';
            36 :
                GetErrorMsg := 'there was an unspecified I/O Error.  ';
            37 :
                GetErrorMsg := 'the file name or volume name is bad (perhaps zero-length).  ';
            39 :
                GetErrorMsg := 'logical end-of-file was reached unexpetedly during read operation.  ';
            40 :
                GetErrorMsg := 'an attempt was made to position before start of file.  ';
            42 :
                GetErrorMsg := 'too many are files open.  ';
            43 :
                GetErrorMsg := 'the file could not be found.  ';
            44 :
                GetErrorMsg := 'the volume is locked by a hardware setting.  ';
            45 :
                GetErrorMsg := 'the file is locked';
            46 :
                GetErrorMsg := 'the volume is locked by a software flag.  ';
            47 :
                GetErrorMsg := 'the file is already in use.  ';
            48 :
                GetErrorMsg := 'a file with the specified name exists and cannot be overwritten.  ';
            49 :
                GetErrorMsg := 'the file is already open for read/write.  It cannot be reopened.  ';
            50 :
                GetErrorMsg := 'no volume was specified and there is no default volume. ';
            51 :
                GetErrorMsg := 'a non-existent path was specified.  ';
            52 :
                GetErrorMsg := 'there was an error finding current position in file.  ';
            53 :
                GetErrorMsg := 'the specified volume is not on-line.  ';
            54 :
                GetErrorMsg := 'there was an attempt to open a locked file for writing.  ';
            55 :
                GetErrorMsg := 'there was an attempt to mount an already mounted volume.  ';
            56 :
                GetErrorMsg := 'the specified drive number is not mounted.  ';
            57 :
                GetErrorMsg := 'the volume lacks Macintosh-format directory.  ';
            58 :
                GetErrorMsg := 'there was an external file system error.  ';
            59 :
                GetErrorMsg := 'there was a problem during rename.  ';
            60 :
                GetErrorMsg := 'the master directory block is bad; this volume must be reinitialized.  ';
            61 :
                GetErrorMsg := 'the read/write permission of the file/folder does not allow writing . ';
            108 :
                GetErrorMsg := 'there is insufficient application memory.  ';
            120 :
                GetErrorMsg := 'the directory could not be found.  ';
            121 :
                GetErrorMsg := 'too many working directories are open.  ';
            122 :
                GetErrorMsg := 'a folder cannot be placed in its own subfolder.  ';
            123 :
                GetErrorMsg := 'an attempt was made to do hierarchical operations on a nonhierarchical volume.  ';
            127 :
                GetErrorMsg := 'there was an internal file system error.  ';
        END;
    END;

    PROCEDURE UpdateResource (vanilla : handle);

    BEGIN

        ChangedResource(vanilla);
        WriteResource(vanilla);

    END;

    PROCEDURE IOCheck (resultCode : OSErr);

        VAR
            ignore : INTEGER;
            errorString : Str255;

    BEGIN

        IF resultCode <> NoErr THEN
            BEGIN
                NumToString(resultCode, errorString);
                ParamText('Macintosh Error #', errorString, ':  ', GetErrorMsg(resultCode));
                InitCursor;
                ignore := StopAlert(305, NIL);
            END

    END;

    FUNCTION StandardFile;
                        {opCode : StandardType;  oldName : Str255; fType : OSType; }
                        {var vRef : integer) :  str63 }
        VAR
            where : Point;
            reply : SFReply;
            textType : SFTypeList;

    BEGIN
        where.h := 80;
        where.v := 55;
        textType[0] := fType;
        reply.vRefNum := vRef;
        IF opCode = StandardGet THEN
            SFGetFile(where, 'Select Application to Launch', NIL, 1, textType, NIL, reply)
        ELSE
            SFPutFile(where, '', oldName, NIL, reply);
        WITH reply DO
            IF NOT good THEN
                StandardFile := ''
            ELSE
                BEGIN
                    StandardFile := fName;
                    vRef := vRefNum
                END
    END;

    PROCEDURE HandleChanges (changedFile : LmirHdl);
    BEGIN

{A boolean field in the LMIR can be set if your change records in memory but you do not}
{immediately write them out to the file...}

{Then put whatever routines you need to handle updates to records in memory here}

    END;

    PROCEDURE RemoveLib; {var whichFile : LmirHdl);  }
        VAR
            ReturnValidHdl : LmirHdl;
    BEGIN

        IF whichFile^^.changed THEN
            HandleChanges(whichFile);
        IF whichFile^^.status = Open THEN
            IOCheck(FSClose(whichFile^^.fRefNum));
        ReturnValidHdl := whichFile^^.next;
        whichFile^^.prev^^.next := whichFile^^.next;
        whichFile^^.next^^.prev := whichFile^^.prev;
        whichFile^^.status := Closed;
        UpdateResource(handle(whichFile));
        ReleaseResource(handle(whichFile));
        whichFile := ReturnValidHdl;
    END;

    PROCEDURE CloseLibList; {Top : LmirHdl; }
        VAR
            next : LmirHdl;
    BEGIN
        next := Top^^.next;
        REPEAT
            RemoveLib(next);
        UNTIL next = Top;
        RemoveLib(Top);
    END;

    FUNCTION OpenWD; {var vREfNum : integer;    }
{                        DirID : longint)            }
{                         : OSErr;                    }

        VAR
            blk : WDPBRec;
            Result : OSErr;

    BEGIN

        blk.ioCompletion := NIL;
        Result := PBGetVol(@blk, false); {this just sets ioWDProcID to whatever...}

        IF Result = NoErr THEN
            BEGIN
                WITH blk DO
                    BEGIN
                        ioNamePtr := NIL;
                        ioVREfNum := vRefNum;
                        ioWDDirID := DirID;
                    END;

                Result := PBOPenWD(@blk, false);
                vRefNum := blk.ioVRefNum;
            END;

        OpenWD := Result;

    END;



    PROCEDURE GetPathInfo;
{                         vRefNum : integer;             }
{                         var rootVol  : Str31;        }
{                         var hfsFlag : boolean );        }
{                           var WDirID : longint;        }
        VAR
            blk : CInfoPBRec;
            volBlk : HParamBlockRec;
            dirname : str255;

    BEGIN
        rootVol := '';
        WITH volBlk DO
            BEGIN
                ioCompletion := NIL;
                ioNamePtr := @rootVol;
                ioVRefNum := vRefNum;
                ioVolindex := 0;
                ioVSigWord := 0;
                IOCheck(PBHGetVINfo(@volBlk, false));
            END;

        rootVol := Concat(rootVol, ':');
        hfsFlag := HFSRunning;

        IF hfsFlag THEN
            WITH blk DO
                BEGIN
                    ioCompletion := NIL;
                    dirname := '';
                    ioNamePtr := @dirname;
                    ioVRefNum := vRefNum;
                    ioFDirINdex := -1;
                    ioDrDirID := 0;
                    IOCheck(PBGetCatINfo(@blk, false));
                    WDirId := ioDrDirID;
                END;

    END;

    FUNCTION CreateLib; {newLib : LmirHdl; prompt : boolean) : boolean}

        CONST
            null = '';
        VAR
            Result : OSERR;

    BEGIN
        CreateLib := False;
        WITH newLib^^ DO
            BEGIN
                Filename := StandardFile(StandardPut, 'Make My Day', 'LMIR', vref);
                IF Filename <> null THEN
                    BEGIN
                        Result := Create(FileName, vRef, 'DAVE', 'LMIR');
                        IF Result = NoErr THEN
                            BEGIN
                                GetPathInfo(vRef, volName, hfsvolume, DirID);
                                CreateLib := True;
                            END
                        ELSE
                            IOCheck(Result);
                    END
            END
    END;

    FUNCTION UserWantsToCreateLib : boolean;
        CONST
            yes = 1;
        VAR
            p1, p2, p3, p4 : str80;
            Response : integer;

    BEGIN

        p1 := 'Create a new library? ';
        p2 := '';
        p3 := '';
        p4 := '';
        ParamText(p1, p2, p3, p4);
        InitCursor;
        Response := CautionAlert(301, NIL);

        IF (Response = Yes) THEN
            UserWantsToCreateLib := true
        ELSE
            UserWantsToCreateLib := false;
    END;

    FUNCTION FindLib; {var  : theLib : LmirHdl; prompt : boolean; result : OSErr) : boolean}

        CONST
            null = '';
        VAR
            dummy : OSERR;
            SaveRef : integer;
    BEGIN
        FindLib := False;
        WITH theLib^^ DO
            BEGIN
                Filename := StandardFile(StandardGet, '', 'LMIR', vref);
                IF FileName <> null THEN
                    BEGIN
                        GetPathInfo(vRef, volName, hfsvolume, DirID);
                        FindLib := True;
                    END;
            END;
    END;

    FUNCTION UserWantsToFindLib (whichLib : LmirHdl;
                                    Reference : Str255;
                                    errorCode : OSErr) : boolean;
        CONST
            yes = 1;
        VAR
            p1, p2, p3, p4 : str80;
            Response : integer;
            UseName : str63;
    BEGIN

        IF whichLib^^.filename = '' THEN
            UseName := Reference
        ELSE
            UseName := whichLib^^.filename;

        p1 := ConCat('The ', UseName, ' File was not opened because ');
        p2 := GetErrorMsg(ErrorCode);
        p3 := 'Look for a library to open?  ';
        p4 := '';
        ParamText(p1, p2, p3, p4);
        InitCursor;
        Response := CautionAlert(301, NIL);

        IF (Response = Yes) THEN
            UserWantsToFindLib := true
        ELSE
            UserWantsToFindLib := false;
    END;

    PROCEDURE GetUserHelp (whichLibrary : LmirHdl;
                                    ReferredToAs : str255;
                                    ErrMsg : OSErr);
        VAR
            Intent, Attainment, Cancelled : boolean;
    BEGIN
        whichLibrary^^.status := NotFound;             {Guilty until proven innocent}
        HLock(Handle(whichLibrary));

        IF UserWantsToFindLib(whichLibrary, ReferredToAs, ErrMsg) THEN
            IF FindLib(whichLibrary) THEN
                BEGIN
                    UpdateResource(Handle(whichLibrary));
                    whichLibrary^^.status := Closed;
                END;

        IF whichLibrary^^.status = NotFound THEN            {User chose not to Open Existing File}
            REPEAT
                Intent := UserWantsToCreateLib;
                IF Intent THEN
                    Attainment := CreateLib(whichLibrary);
                IF Intent AND Attainment THEN
                    BEGIN
                        UpdateResource(Handle(whichLibrary));
                        whichLibrary^^.status := Closed;
                    END;
            UNTIL (NOT Intent) OR (Attainment);

        HUnLock(Handle(whichLibrary));

    END;

    FUNCTION LibOpenedSuccessfully (LibToOpen : LmirHdl;
                                    VAR Result : OSErr) : boolean;
        VAR
            fRefNum : integer;
            SaveCurrentvol : integer;
            Success : boolean;
            Ignore : OSErr;
    BEGIN
        Success := False;
        Ignore := GetVol(NIL, SaveCurrentVol);            {Save the default volume }
        MoveHHI(Handle(LibToOpen));
        HLock(Handle(LibToOpen));
        WITH LibToOpen^^ DO
            BEGIN
                result := SetVol(@volname, 0);                  {Is the root volume mounted?}
                IF Result = NoErr THEN
                    result := GetVol(NIL, vRef);                     {Then make it default }
                IF (Result = NoErr) AND hfsVolume THEN        {Open the Working Directory}
                    Result := OpenWD(vRef, DirID);
                IF Result = NoErr THEN                        {Vref is now correct whether HFS or MFS}
                    Result := FSOpen(fileName, vRef, fRefNum);
                IF Result = NoErr THEN
                    BEGIN
                        Success := True;
                        status := open;
                    END;
            END;

        HUnLock(Handle(LibToOpen));
        LibOpenedSuccessfully := Success;
        Ignore := SetVol(NIL, SaveCurrentVol);            {Restore the original default volume}
    END;

    PROCEDURE InitLibResource (VAR Lib : LmirHdl;
                                    LibName : str255);

    BEGIN

        Lib := LmirHdl(newHandle(SizeOf(Lmir)));
        Lib^^.RsrcId := uniqueID('LMIR');
        WITH Lib^^ DO
            BEGIN
                vRef := 0;
                RecsOnFile := 0;
                filename := '';
                volname := '';
                DirID := 0;
                FTyp := 0;
                RecsOnFile := 0;
                CurRec := 0;
                status := NotFound;
                changed := false;
            END;

        AddResource(Handle(Lib), 'LMIR', Lib^^.RsrcID, LibName);

    END;

    PROCEDURE GetLibraryResource; {var theLibrary : LmirHdl;  ResourceName : str255}
    BEGIN

        IF NewRoms THEN
            theLibrary := LmirHdl(Get1NamedResource('LMIR', ResourceName))
        ELSE
            theLibrary := LmirHdl(GetNamedResource('LMIR', ResourceName));
    END;

    PROCEDURE OpenLib; {var whichLib : LmirHdl; itsName : str255}
        VAR
            Result : OSErr;
    BEGIN

        GetLibraryResource(whichLib, itsName);
        IF whichLib = NIL THEN
            InitLibResource(whichLib, itsName);        {No resource even exists... Create one}

{Potential Problem #1 - The resource was *just* created by GetLibrary}
        IF whichLib^^.status = NotFound THEN     {A resource exists, but no file }
            GetUserHelp(whichLib, itsName, 43);

{Potential Problem #2 - The resource is there but the file couldn't be opened}
        WHILE (whichLib^^.status = Closed) AND (NOT LibOpenedSuccessfully(whichLib, result)) DO
            GetUserHelp(whichLib, itsName, Result);

{Note: if the user refuses to either look for or create a file, then status will be set to NotFound}
{and the loop ends.  Of course, the loop also ends if a file is opened successfully.  }
        whichLib^^.next := whichLib;
        whichLib^^.prev := whichLib;
    END;

    PROCEDURE OpenLinkedLib; {LinkTo : LmirHdl;}
{                                    ResName : str255);}
        VAR
            newLib : LmirHdl;
    BEGIN

        OpenLib(newLib, ResName);
        newLib^^.next := LinkTo^^.next;
        LinkTo^^.next := newLib;

        newLib^^.prev := LinkTo;
        newLib^^.next^^.prev := newLib;


    END;

END.